VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsLevel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const m_nMaxKey As Long = 7 'must be 2^n-1

Private Type typeLevel
 sLevelName As String
 nWidth As Long
 nHeight As Long
 objNodes() As ILevelNode
 '///only for game logic
 bGameInitialized As Boolean
 objEntities() As ILevelNode
 nKeys(m_nMaxKey) As Long 'only 0-3 are keys, other are collectibles
 nSelectedKey As Long
 nPlayerCount As Long
 nCurrentPlayerX As Long
 nCurrentPlayerY As Long
 sErrorMsg As String
End Type

Private m_t As typeLevel

Friend Property Get PlayerCount() As Long
PlayerCount = m_t.nPlayerCount
End Property

Friend Property Get SelectedKey() As Long
SelectedKey = m_t.nSelectedKey
End Property

Friend Property Let SelectedKey(ByVal n As Long)
m_t.nSelectedKey = n And m_nMaxKey
End Property

Friend Property Get KeyCount(ByVal nIndex As Long) As Long
KeyCount = m_t.nKeys(nIndex And m_nMaxKey)
End Property

Friend Property Let KeyCount(ByVal nIndex As Long, ByVal n As Long)
m_t.nKeys(nIndex And m_nMaxKey) = n
End Property

Friend Function UseKey(ByVal x As Long, ByVal y As Long) As Boolean
Dim objPlayer As ILevelNode
Dim obj As ILevelNode
Dim nCurrentKey As Long
Dim i As Long, j As Long
'///some sanity check
If Not m_t.bGameInitialized Then Exit Function
If x < 0 Or y < 0 Or x >= m_t.nWidth Or y >= m_t.nHeight Then Exit Function
If m_t.nCurrentPlayerX = x Then
 If m_t.nCurrentPlayerY <> y + 1 And m_t.nCurrentPlayerY <> y - 1 Then Exit Function
ElseIf m_t.nCurrentPlayerY = y Then
 If m_t.nCurrentPlayerX <> x + 1 And m_t.nCurrentPlayerX <> x - 1 Then Exit Function
Else
 Exit Function
End If
nCurrentKey = m_t.nSelectedKey
If m_t.nKeys(nCurrentKey) <= 0 Then Exit Function
If m_t.nCurrentPlayerX < 0 Or m_t.nCurrentPlayerY < 0 Or m_t.nCurrentPlayerX >= m_t.nWidth Or m_t.nCurrentPlayerY >= m_t.nHeight Then Exit Function
Set objPlayer = m_t.objEntities(m_t.nCurrentPlayerX, m_t.nCurrentPlayerY)
If objPlayer Is Nothing Then Exit Function
If Not objPlayer.IsPlayer Then Exit Function
'///
Set obj = m_t.objNodes(x, y)
If Not obj Is Nothing Then
 If Not obj.BeforeUseKey(Me, objPlayer, m_t.nCurrentPlayerX, m_t.nCurrentPlayerY, x, y, nCurrentKey) Then
  Set obj = Nothing
 End If
End If
If obj Is Nothing Then
 Set obj = m_t.objEntities(x, y)
 If Not obj Is Nothing Then
  If Not obj.BeforeUseKey(Me, objPlayer, m_t.nCurrentPlayerX, m_t.nCurrentPlayerY, x, y, nCurrentKey) Then
   Set obj = Nothing
  End If
 End If
End If
If obj Is Nothing Then Exit Function
'///now we can use item
m_t.nKeys(nCurrentKey) = m_t.nKeys(nCurrentKey) - 1
obj.AfterUseKey Me, objPlayer, m_t.nCurrentPlayerX, m_t.nCurrentPlayerY, x, y, nCurrentKey 'selected key can be changed dynamically
'///check if we need to recalculate player count
If m_t.objEntities(m_t.nCurrentPlayerX, m_t.nCurrentPlayerY) Is objPlayer Then
 'do nothing
ElseIf m_t.objEntities(x, y) Is objPlayer Then
 m_t.nCurrentPlayerX = x
 m_t.nCurrentPlayerY = y
Else
 'it looks like that the player disappears
 x = -1
 y = -1
 For j = 0 To m_t.nHeight - 1
  For i = 0 To m_t.nWidth - 1
   If m_t.objEntities(i, j) Is objPlayer Then
    x = i
    y = j
   End If
   If x >= 0 Then Exit For
  Next i
  If x >= 0 Then Exit For
 Next j
 If x >= 0 Then
  m_t.nCurrentPlayerX = x
  m_t.nCurrentPlayerY = y
 Else
  m_t.nPlayerCount = m_t.nPlayerCount - 1
  SwitchPlayer
 End If
End If
'///over
UseKey = True
End Function

Friend Property Get ErrorMessage() As String
ErrorMessage = m_t.sErrorMsg
End Property

Friend Property Let ErrorMessage(ByVal s As String)
m_t.sErrorMsg = s
End Property

'currently there is no animation
Friend Function MovePlayer(ByVal dx As Long, ByVal dy As Long) As Boolean
MovePlayer = MoveEntity(m_t.nCurrentPlayerX, m_t.nCurrentPlayerY, dx, dy, True, False) <> 0
End Function

'currently there is no animation
'return value = (dx)|(dy<<12) which only takes slip into account, not teleport, etc.
Friend Function MoveEntity(ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal bMovePlayer As Boolean, ByVal bMoveOther As Boolean) As Long
Dim obj As ILevelNode, objBeingPushed As ILevelNode
Dim objLeave As ILevelNode, objEnter As ILevelNode
Dim x2 As Long, y2 As Long, dx2 As Long, dy2 As Long
Dim i As Long, j As Long
'///some sanity check
If Not m_t.bGameInitialized Then Exit Function
If x < 0 Or y < 0 Or x >= m_t.nWidth Or y >= m_t.nHeight Then Exit Function
x2 = x + dx
y2 = y + dy
If x2 < 0 Or y2 < 0 Or x2 >= m_t.nWidth Or y2 >= m_t.nHeight Then Exit Function
Set obj = m_t.objEntities(x, y)
If obj Is Nothing Then Exit Function
If obj.IsPlayer Then
 bMoveOther = False
 If Not bMovePlayer Then Exit Function
Else
 bMovePlayer = False
 If Not bMoveOther Then Exit Function
End If
'///run game logic
Set objLeave = m_t.objNodes(x, y)
Set objEnter = m_t.objNodes(x2, y2)
If Not objLeave Is Nothing Then
 If Not objLeave.BeforeEntityLeave(Me, obj, x, y, dx, dy, False) Then Exit Function
End If
If Not objEnter Is Nothing Then
 If Not objEnter.BeforeEntityEnter(Me, obj, x, y, dx, dy, False) Then Exit Function
End If
'///check if two entity clashes
Set objBeingPushed = m_t.objEntities(x2, y2)
If Not objBeingPushed Is Nothing Then
 'player can't push things if he is slippery
 If bMovePlayer Then
  If obj.IsEntitySlippery(Me, x, y, dx, dy) Then Exit Function
 End If
 'check the game logic
 If Not obj.BeforePushEntity(Me, objBeingPushed, x, y, dx, dy) Then Exit Function
 If Not objBeingPushed.BeforeEntityBeingPushed(Me, obj, x2, y2, dx, dy) Then Exit Function
 'try to push it first
 dx2 = MoveEntity(x2, y2, dx, dy, False, True)
 If dx2 = 0 Then Exit Function
 'get the adjusted dx & dy
 dy2 = (dx2 And &HFFF000) \ &H1000&
 If dy2 And &H800& Then dy2 = dy2 Or &HFFFFF000
 dx2 = dx2 And &HFFF&
 If dx2 And &H800& Then dx2 = dx2 Or &HFFFFF000
End If
'///we are permitted to move entity now
'first some game logic for entity being pushed
If Not objBeingPushed Is Nothing Then objBeingPushed.AfterEntityBeingPushed Me, obj, x2, y2, dx2, dy2
'move current entity
Set m_t.objEntities(x, y) = Nothing
Do
 Set m_t.objEntities(x2, y2) = obj
 If Not objLeave Is Nothing Then objLeave.AfterEntityLeave Me, obj, x2 - dx, y2 - dy, dx, dy, False
 If Not objEnter Is Nothing Then objEnter.AfterEntityEnter Me, obj, x2 - dx, y2 - dy, dx, dy, False
 'exit if the entity disappears
 If Not m_t.objEntities(x2, y2) Is obj Then Exit Do
 'now check slippery
 If Not obj.IsEntitySlippery(Me, x2, y2, dx, dy) Then Exit Do
 If x2 + dx < 0 Or y2 + dy < 0 Or x2 + dx >= m_t.nWidth Or y2 + dy >= m_t.nHeight Then Exit Do
 'check game logic
 Set objLeave = objEnter
 Set objEnter = m_t.objNodes(x2 + dx, y2 + dy)
 If Not objLeave Is Nothing Then
  If Not objLeave.BeforeEntityLeave(Me, obj, x2, y2, dx, dy, False) Then Exit Do
 End If
 If Not objEnter Is Nothing Then
  If Not objEnter.BeforeEntityEnter(Me, obj, x2, y2, dx, dy, False) Then Exit Do
 End If
 If Not m_t.objEntities(x2 + dx, y2 + dy) Is Nothing Then Exit Do
 'OK we slip one more time
 Set m_t.objEntities(x2, y2) = Nothing
 x2 = x2 + dx
 y2 = y2 + dy
Loop
'adjust dx & dy
dx = x2 - x
dy = y2 - y
'///run game logic again
If Not objBeingPushed Is Nothing Then obj.AfterPushEntity Me, objBeingPushed, x, y, dx, dy
'///check if we need to recalculate player count
If bMovePlayer Then
 If m_t.objEntities(x2, y2) Is obj Then
  m_t.nCurrentPlayerX = x2
  m_t.nCurrentPlayerY = y2
 Else
  'it looks like that the player disappears
  x2 = -1
  y2 = -1
  For j = 0 To m_t.nHeight - 1
   For i = 0 To m_t.nWidth - 1
    If m_t.objEntities(i, j) Is obj Then
     x2 = i
     y2 = j
    End If
    If x2 >= 0 Then Exit For
   Next i
   If x2 >= 0 Then Exit For
  Next j
  If x2 >= 0 Then
   m_t.nCurrentPlayerX = x2
   m_t.nCurrentPlayerY = y2
  Else
   m_t.nPlayerCount = m_t.nPlayerCount - 1
   SwitchPlayer
  End If
 End If
End If
'///over
MoveEntity = (dx And &HFFF&) Or ((dy And &HFFF&) * &H1000&)
End Function

'NOTE: This function will not update CurrentPlayer{X,Y} !!!
Friend Function TeleportEntityInternal(ByVal x As Long, ByVal y As Long, ByVal x2 As Long, ByVal y2 As Long) As Boolean
Dim obj As ILevelNode
Dim objLeave As ILevelNode, objEnter As ILevelNode
Dim dx As Long, dy As Long
'///some sanity check
If Not m_t.bGameInitialized Then Exit Function
If x < 0 Or y < 0 Or x >= m_t.nWidth Or y >= m_t.nHeight Then Exit Function
If x2 < 0 Or y2 < 0 Or x2 >= m_t.nWidth Or y2 >= m_t.nHeight Then Exit Function
If x = x2 And y = y2 Then
 TeleportEntityInternal = True
 Exit Function
End If
Set obj = m_t.objEntities(x, y)
If obj Is Nothing Then Exit Function
'///run game logic
dx = x2 - x
dy = y2 - y
Set objLeave = m_t.objNodes(x, y)
Set objEnter = m_t.objNodes(x2, y2)
If Not objLeave Is Nothing Then
 If Not objLeave.BeforeEntityLeave(Me, obj, x, y, dx, dy, True) Then Exit Function
End If
If Not objEnter Is Nothing Then
 If Not objEnter.BeforeEntityEnter(Me, obj, x, y, dx, dy, True) Then Exit Function
End If
'///check if two entity clashes
If Not m_t.objEntities(x2, y2) Is Nothing Then Exit Function
'///we are permitted to move entity now
Set m_t.objEntities(x, y) = Nothing
Set m_t.objEntities(x2, y2) = obj
'///game logic
If Not objLeave Is Nothing Then objLeave.AfterEntityLeave Me, obj, x, y, dx, dy, True
If Not objEnter Is Nothing Then objEnter.AfterEntityEnter Me, obj, x, y, dx, dy, True
'///over
TeleportEntityInternal = True
End Function

Friend Function SwitchPlayer(Optional ByVal x As Long = -1, Optional ByVal y As Long = -1) As Boolean
Dim obj As ILevelNode
Dim n As Long
If Not m_t.bGameInitialized Then Exit Function
If x < 0 Or y < 0 Or x >= m_t.nWidth Or y >= m_t.nHeight Then
 '///switch to next player
 x = m_t.nCurrentPlayerX
 y = m_t.nCurrentPlayerY
 For n = 0 To m_t.nWidth * m_t.nHeight - 2
  x = x + 1
  If x >= m_t.nWidth Then
   x = 0
   y = y + 1
   If y >= m_t.nHeight Then y = 0
  End If
  Set obj = m_t.objEntities(x, y)
  If Not obj Is Nothing Then
   If obj.IsPlayer Then
    m_t.nCurrentPlayerX = x
    m_t.nCurrentPlayerY = y
    SwitchPlayer = True
    Exit Function
   End If
  End If
 Next n
ElseIf x <> m_t.nCurrentPlayerX Or y <> m_t.nCurrentPlayerY Then
 '///switch to specified player
 Set obj = m_t.objEntities(x, y)
 If Not obj Is Nothing Then
  If obj.IsPlayer Then
   m_t.nCurrentPlayerX = x
   m_t.nCurrentPlayerY = y
   SwitchPlayer = True
  End If
 End If
End If
End Function

Friend Sub StartGame()
Dim i As Long, j As Long
Dim obj As ILevelNode
'///
Debug.Assert Not m_t.bGameInitialized
'///
m_t.nSelectedKey = 0
m_t.nPlayerCount = 0
m_t.nCurrentPlayerX = 0
m_t.nCurrentPlayerY = 0
'///init entities
If m_t.nWidth > 0 And m_t.nHeight > 0 Then
 ReDim m_t.objEntities(m_t.nWidth - 1, m_t.nHeight - 1)
 For j = 0 To m_t.nHeight - 1
  For i = 0 To m_t.nWidth - 1
   Set obj = m_t.objNodes(i, j)
   If Not obj Is Nothing Then
    If obj.IsEntity Then
     If obj.IsPlayer Then
      If m_t.nPlayerCount = 0 Then
       m_t.nCurrentPlayerX = i
       m_t.nCurrentPlayerY = j
      End If
      m_t.nPlayerCount = m_t.nPlayerCount + 1
     End If
     Set m_t.objEntities(i, j) = obj
     Set m_t.objNodes(i, j) = Nothing
    End If
   End If
  Next i
 Next j
Else
 Erase m_t.objEntities
End If
Erase m_t.nKeys
m_t.sErrorMsg = vbNullString
'///
m_t.bGameInitialized = True
End Sub

Friend Function Serialize() As clsTreeStorageNode
Dim obj As clsTreeStorageNode
Dim obj1 As ILevelNode
Dim ret As New clsTreeStorageNode
Dim i As Long, j As Long, l As Long
Dim s As String
Dim v() As String
'///
ret.SetNameFromString "Level"
ret.AddSubNode , , "Name", m_t.sLevelName
ret.AddSubNode , , "Width", CStr(m_t.nWidth)
ret.AddSubNode , , "Height", CStr(m_t.nHeight)
'///
For j = 0 To m_t.nHeight - 1
 For i = 0 To m_t.nWidth - 1
  Set obj1 = m_t.objNodes(i, j)
  If Not obj1 Is Nothing Then
   Set obj = New clsTreeStorageNode
   obj.SetNameFromString "Node"
   obj.AddSubNode , , "X", CStr(i)
   obj.AddSubNode , , "Y", CStr(j)
   obj.AddSubNode , , "Type", obj1.NodeType
   '///
   s = Trim(obj1.GetPropertyList)
   If s <> vbNullString Then
    v = Split(s, ",")
    For l = 0 To UBound(v)
     s = Trim(v(l))
     If s <> vbNullString Then
      obj.AddSubNode , , s, obj1.NodeProperty(s)
     End If
    Next l
   End If
   '///
   ret.AddSubNode 1, obj
  End If
 Next i
Next j
'///
Set Serialize = ret
End Function

Friend Function Deserialize(ByVal objNode As clsTreeStorageNode) As Boolean
Dim i As Long, j As Long, k As Long, l As Long
Dim obj As clsTreeStorageNode
Dim obj1 As ILevelNode
Dim s As String
Dim v() As String
'///
m_t.sLevelName = objNode.GetSubNodeValueAsStringByName("Name")
m_t.nWidth = Val(objNode.GetSubNodeValueAsStringByName("Width"))
m_t.nHeight = Val(objNode.GetSubNodeValueAsStringByName("Height"))
If m_t.nWidth > 0 And m_t.nHeight > 0 Then
 ReDim m_t.objNodes(m_t.nWidth - 1, m_t.nHeight - 1)
 For k = 1 To objNode.SubNodeCount
  If objNode.SubNodeType(k) = 1 Then
   Set obj = objNode.SubNodeObject(k)
   If Not obj Is Nothing Then
    If obj.GetNameAsString = "Node" Then
     i = Val(obj.GetSubNodeValueAsStringByName("X", "-1"))
     j = Val(obj.GetSubNodeValueAsStringByName("Y", "-1"))
     If i >= 0 And i < m_t.nWidth And j >= 0 And j < m_t.nHeight Then
      Set obj1 = CreateLevelNode(obj.GetSubNodeValueAsStringByName("Type"))
      '///
      s = Trim(obj1.GetPropertyList)
      If s <> vbNullString Then
       v = Split(s, ",")
       For l = 0 To UBound(v)
        s = Trim(v(l))
        If s <> vbNullString Then
         obj1.NodeProperty(s) = obj.GetSubNodeValueAsStringByName(s)
        End If
       Next l
      End If
      '///
      Set m_t.objNodes(i, j) = obj1
     End If
    End If
   End If
  End If
 Next k
Else
 m_t.nWidth = 0
 m_t.nHeight = 0
 Erase m_t.objNodes
End If
Deserialize = True
End Function

Friend Sub CloneFrom(ByRef t As typeLevel)
Dim i As Long, j As Long
Dim obj As ILevelNode
m_t = t
For j = 0 To m_t.nHeight - 1
 For i = 0 To m_t.nWidth - 1
  Set obj = m_t.objNodes(i, j)
  If Not obj Is Nothing Then Set m_t.objNodes(i, j) = obj.Clone
 Next i
Next j
'///for game logic
If m_t.bGameInitialized Then
 For j = 0 To m_t.nHeight - 1
  For i = 0 To m_t.nWidth - 1
   Set obj = m_t.objEntities(i, j)
   If Not obj Is Nothing Then Set m_t.objEntities(i, j) = obj.Clone
  Next i
 Next j
Else
 Erase m_t.objEntities
End If
End Sub

Friend Function Clone() As clsLevel
Dim obj As New clsLevel
obj.CloneFrom m_t
Set Clone = obj
End Function

Friend Property Get LevelName() As String
LevelName = m_t.sLevelName
End Property

Friend Property Let LevelName(ByVal s As String)
m_t.sLevelName = s
End Property

Friend Property Get Width() As Long
Width = m_t.nWidth
End Property

Friend Property Get Height() As Long
Height = m_t.nHeight
End Property

Friend Property Get LevelNode(ByVal i As Long, ByVal j As Long) As ILevelNode
Dim obj As ILevelNode
If i < 0 Or i >= m_t.nWidth Or j < 0 Or j >= m_t.nHeight Then
 Set obj = New ILevelNode
 obj.NodeType = "Wall"
 Set LevelNode = obj
Else
 Set LevelNode = m_t.objNodes(i, j)
End If
End Property

Friend Property Set LevelNode(ByVal i As Long, ByVal j As Long, ByVal obj As ILevelNode)
If i >= 0 And i < m_t.nWidth And j >= 0 And j < m_t.nHeight Then
 Set m_t.objNodes(i, j) = obj
End If
End Property

Friend Property Get LevelEntity(ByVal i As Long, ByVal j As Long) As ILevelNode
If m_t.bGameInitialized Then
 If i >= 0 And i < m_t.nWidth And j >= 0 And j < m_t.nHeight Then
  Set LevelEntity = m_t.objEntities(i, j)
 End If
End If
End Property

Friend Property Set LevelEntity(ByVal i As Long, ByVal j As Long, ByVal obj As ILevelNode)
If m_t.bGameInitialized Then
 If i >= 0 And i < m_t.nWidth And j >= 0 And j < m_t.nHeight Then
  Set m_t.objEntities(i, j) = obj
 End If
End If
End Property

'used only for drawing walls
'WARNING: don't use this for game logic!!!
Friend Property Get IsWall(ByVal i As Long, ByVal j As Long) As Boolean
Dim obj As ILevelNode
If i < 0 Or i >= m_t.nWidth Or j < 0 Or j >= m_t.nHeight Then
 IsWall = True
Else
 Set obj = m_t.objNodes(i, j)
 If Not obj Is Nothing Then IsWall = obj.IsWall
End If
End Property

Friend Sub Create(Optional ByVal w As Long = 9, Optional ByVal h As Long = 9)
m_t.sLevelName = objText.GetText("Unnamed level")
If w > 0 And h > 0 Then
 m_t.nWidth = w
 m_t.nHeight = h
 ReDim m_t.objNodes(w - 1, h - 1)
 '///
 w = (w - 1) \ 2
 Set m_t.objNodes(w, 0) = New ILevelNode
 With m_t.objNodes(w, 0)
  .NodeType = "Player"
  .NodeProperty("Value") = "0"
  .NodeProperty("ForceType") = "1"
  .NodeProperty("Max") = "1000"
  .NodeProperty("Min") = "-999"
 End With
 If h > 1 Then
  h = h - 1
  Set m_t.objNodes(w, h) = New ILevelNode
  With m_t.objNodes(w, h)
   .NodeType = "Goal"
  End With
 End If
Else
 m_t.nWidth = 0
 m_t.nHeight = 0
 Erase m_t.objNodes
End If
End Sub

Friend Sub Resize(ByVal w As Long, ByVal h As Long)
Dim objNodes() As ILevelNode
Dim i As Long, j As Long
If w > 0 And h > 0 Then
 ReDim objNodes(w - 1, h - 1)
 If m_t.nWidth > w Then m_t.nWidth = w
 If m_t.nHeight > h Then m_t.nHeight = h
 For j = 0 To m_t.nHeight - 1
  For i = 0 To m_t.nWidth - 1
   Set objNodes(i, j) = m_t.objNodes(i, j)
  Next i
 Next j
 m_t.nWidth = w
 m_t.nHeight = h
 m_t.objNodes = objNodes
Else
 m_t.nWidth = 0
 m_t.nHeight = 0
 Erase m_t.objNodes
End If
End Sub

Friend Sub Draw(ByVal bm As cAlphaDibSection, ByVal dx As Long, ByVal dy As Long, Optional ByVal nSelectedX As Long = -1, Optional ByVal nSelectedY As Long = -1)
Dim obj As ILevelNode
Dim i As Long, j As Long
Dim i1 As Long, j1 As Long
Dim i2 As Long, j2 As Long
Dim hbr(2) As Long
Dim r As RECT
'///
hbr(0) = CreateSolidBrush(&H800000) 'selection
hbr(1) = CreateSolidBrush(&H78C0B4) 'wall
hbr(2) = CreateSolidBrush(&HD1DCE5) 'empty
'///draw background
r.Right = bm.Width
r.Bottom = bm.Height
FillRect bm.hdc, r, hbr(1)
'///get draw area
i1 = dx \ 64 - 1
j1 = dy \ 64 - 1
i2 = (dx + r.Right) \ 64 + 2
j2 = (dy + r.Bottom) \ 64 + 2
If i1 < 0 Then i1 = 0
If i2 >= m_t.nWidth Then i2 = m_t.nWidth - 1
If j1 < 0 Then j1 = 0
If j2 >= m_t.nHeight Then j2 = m_t.nHeight - 1
'///draw wall and corners
For j = j1 To j2
 r.Top = j * 64 - dy
 r.Bottom = r.Top + 64
 For i = i1 To i2
  r.Left = i * 64 - dx
  r.Right = r.Left + 64
  If IsWall(i, j) Then
   If Not IsWall(i - 1, j) Then
    If Not IsWall(i, j - 1) Then
     bmTiles.PaintPicture bm.hdc, r.Left, r.Top, 12, 12, 0, 0
    End If
    If Not IsWall(i, j + 1) Then
     bmTiles.PaintPicture bm.hdc, r.Left, r.Bottom - 12, 12, 12, 0, 12
    End If
   End If
   If Not IsWall(i + 1, j) Then
    If Not IsWall(i, j - 1) Then
     bmTiles.PaintPicture bm.hdc, r.Right - 12, r.Top, 12, 12, 12, 0
    End If
    If Not IsWall(i, j + 1) Then
     bmTiles.PaintPicture bm.hdc, r.Right - 12, r.Bottom - 12, 12, 12, 12, 12
    End If
   End If
  Else
   FillRect bm.hdc, r, hbr(2)
   If IsWall(i - 1, j) Then
    If IsWall(i - 1, j - 1) Then
     If IsWall(i, j - 1) Then
      bmTiles.PaintPicture bm.hdc, r.Left, r.Top, 12, 12, 0, 24
     End If
    End If
    If IsWall(i - 1, j + 1) Then
     If IsWall(i, j + 1) Then
      bmTiles.PaintPicture bm.hdc, r.Left, r.Bottom - 12, 12, 12, 0, 36
     End If
    End If
   End If
   If IsWall(i + 1, j) Then
    If IsWall(i + 1, j - 1) Then
     If IsWall(i, j - 1) Then
      bmTiles.PaintPicture bm.hdc, r.Right - 12, r.Top, 12, 12, 12, 24
     End If
    End If
    If IsWall(i + 1, j + 1) Then
     If IsWall(i, j + 1) Then
      bmTiles.PaintPicture bm.hdc, r.Right - 12, r.Bottom - 12, 12, 12, 12, 36
     End If
    End If
   End If
  End If
 Next i
Next j
'///draw tiles
For j = j1 To j2
 r.Top = j * 64 - dy
 For i = i1 To i2
  Set obj = m_t.objNodes(i, j)
  If Not obj Is Nothing Then
   obj.Draw bm, i * 64 - dx, r.Top, Not m_t.bGameInitialized
  End If
 Next i
Next j
'///draw entities
If m_t.bGameInitialized Then
 For j = j1 To j2
  r.Top = j * 64 - dy
  For i = i1 To i2
   Set obj = m_t.objEntities(i, j)
   If Not obj Is Nothing Then
    obj.Draw bm, i * 64 - dx, r.Top, i = m_t.nCurrentPlayerX And j = m_t.nCurrentPlayerY
   End If
  Next i
 Next j
End If
'///draw selected (in edit mode)
If nSelectedX >= i1 And nSelectedX <= i2 And nSelectedY >= j1 And nSelectedY <= j2 Then
 nSelectedX = nSelectedX * 64 - dx
 nSelectedY = nSelectedY * 64 - dy
 For i = 0 To 56 Step 14
  r.Left = nSelectedX + i
  r.Top = nSelectedY
  r.Right = r.Left + 7
  r.Bottom = r.Top + 2
  FrameRect bm.hdc, r, hbr(0)
  r.Bottom = nSelectedY + 64
  r.Top = r.Bottom - 2
  FrameRect bm.hdc, r, hbr(0)
  r.Left = nSelectedX
  r.Top = nSelectedY + i
  r.Right = r.Left + 2
  r.Bottom = r.Top + 7
  FrameRect bm.hdc, r, hbr(0)
  r.Right = nSelectedX + 64
  r.Left = r.Right - 2
  FrameRect bm.hdc, r, hbr(0)
 Next i
End If
'///
For i = 0 To 2
 DeleteObject hbr(i)
Next i
End Sub
